home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb11.zip / PRINTUSG.INC < prev    next >
Text File  |  1985-08-05  |  2KB  |  58 lines
  1. {PRINTUSG.INC}
  2. PROCEDURE PrintUsing ( Mask : String80; Number  : real );
  3.  
  4. {
  5. This procedure emulates the PRINT USING routine available
  6. in many versions of MicroSoft BASIC.
  7.  
  8. Source: "PRINTUSING: Formatting Printed Strings", TUG Lines Volume I Issue 4
  9. Author: Bill Collins
  10. Application: CP/M-80, CP/M-86, MS-DOS, PC-DOS
  11. }
  12.  
  13.  
  14. const
  15.           Comma     : char = ',';
  16.           Point     : char = '.';
  17.           minusSign : char = '-';
  18. var
  19.           FieldWidth, IntegerLength, I, J, Places,PointPosition :integer;
  20.           UsingCommas, Decimal, Negative : boolean;
  21.           OutString, IntegerString       : String80;
  22.  
  23. Begin
  24.           Negative       := Number < 0;
  25.           Number         := abs ( Number );
  26.           Places         := 0;
  27.           FieldWidth     := length ( Mask );
  28.           UsingCommas    := pos ( Comma, Mask ) > 0;
  29.           Decimal        := pos ( Point, Mask ) > 0;
  30.           If Decimal then
  31.                begin
  32.                     PointPosition := pos ( Point, Mask );
  33.                     Places        := FieldWidth - PointPosition
  34.                     end;
  35.           Str ( Number : 0 : Places, OutString );
  36.  
  37.           If UsingCommas then
  38.                begin
  39.                     J := 0;
  40.                     IntegerString  :=  copy (OutString, 1, length ( Outstring ) - Places );
  41.                     IntegerLength := length ( IntegerString );
  42.                     If Decimal then
  43.                          IntegerLength := IntegerLength - 1;
  44.                     For I := IntegerLength downto 2 do
  45.                          begin
  46.                               J := J + 1;
  47.                               If J mod 3 = 0 then
  48.                                    Insert ( Comma, OutString, I )
  49.                          end
  50.                     end;
  51.  
  52.           If Negative then
  53.                OutString := MinusSign + OutString;
  54.  
  55.           Write ( OutString : FieldWidth + 1 ) (* Allow extra space for minus sign *)
  56.  
  57. End; (* PrintUsing *)
  58.